home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / NewGUI / SelectGadget / SGCustomTest.e < prev    next >
Text File  |  1998-05-30  |  7KB  |  192 lines
  1. /*  Select.gadget test 2 (25.5.98)              */
  2. /*  Originally Written for SAS/C                */
  3. /*  Compile: SC LINK SGCustomTest               */
  4. /*  © 1998 Massimo Tantignone                   */
  5. /*  Translated (30.05.98) to AmigaE by:         */
  6. /*  THE DARK FRONTIER Softwareentwicklungen     */
  7. /*  Grundler Mathias                            */
  8. /*  frontier@starbase.inka.de                   */
  9.  
  10. MODULE  'exec/ports'
  11. MODULE  'graphics/text'
  12. MODULE  'graphics/rastport'
  13. MODULE  'intuition/intuition'
  14. MODULE  'intuition/screens'
  15. MODULE  'intuition/gadgetclass'
  16. MODULE  'libraries/gadtools'
  17. MODULE  'gadtools'
  18. MODULE  'gadgets/select'
  19. MODULE  'selectgadget'
  20.  
  21. ENUM    ERR_GADTOOLS=1,
  22.         ERR_GADGET,
  23.         ERR_WIN
  24.  
  25. PROC main()     HANDLE
  26.  DEF    scr=NIL:PTR TO screen,
  27.         win=NIL:PTR TO window,
  28.         imsg=NIL:PTR TO intuimessage,
  29.         dri=NIL:PTR TO drawinfo,
  30.         vi=NIL,
  31.         class,
  32.         code,
  33.         fine=FALSE,
  34.         width=640,
  35.         height=200,
  36.         one=FALSE,
  37.         two=FALSE,
  38.         ng:newgadget,           -> staticly created!!!
  39.         gad1=NIL:PTR TO gadget,
  40.         gad2=NIL:PTR TO gadget,
  41.         glist=NIL:PTR TO gadget,
  42.         iaddress=NIL:PTR TO gadget,
  43.         labels1=NIL,
  44.         labels2=NIL
  45.  
  46.    labels1:=[   'First option',
  47.                 'Second option',
  48.                 'Third option',
  49.                 'Fourth option',
  50.                 NIL]
  51.    labels2:=[  'This is a',
  52.                'GadTools gadget',
  53.                'which was made',
  54.                'pop-up',
  55.                'by the support',
  56.                'functions of',
  57.                'the select.gadget',
  58.                'library.',
  59.                NIL]
  60.  
  61. -> The original Source doesn`t open the GadTools-Library !!!
  62.  
  63.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise(ERR_GADTOOLS)
  64.    selectgadgetbase:=OpenLibrary('select.gadget',40)
  65.    IF (selectgadgetbase=NIL) THEN selectgadgetbase := OpenLibrary('Gadgets/select.gadget',40)
  66.    IF (selectgadgetbase=NIL) THEN selectgadgetbase := OpenLibrary('Classes/Gadgets/select.gadget',40)
  67.  
  68.    IF (selectgadgetbase=NIL) THEN Raise(ERR_GADGET)
  69.  
  70.    IF (scr := LockPubScreen(NIL))
  71.     width := scr.width
  72.      height := scr.height
  73.     UnlockPubScreen(NIL,scr)
  74.    ENDIF
  75.  
  76.    IF (win := OpenWindowTagList(NIL,[WA_LEFT,(width - 500) / 2,
  77.                                  WA_TOP,(height - 160) / 2,
  78.                                  WA_WIDTH,500,WA_HEIGHT,160,
  79.                                  WA_MINWIDTH,100,WA_MINHEIGHT,100,
  80.                                  WA_CLOSEGADGET,TRUE,
  81.                                  WA_SIZEGADGET,TRUE,
  82.                                  WA_DEPTHGADGET,TRUE,
  83.                                  WA_DRAGBAR,TRUE,
  84.                                  WA_SIMPLEREFRESH,TRUE,
  85.                                  WA_ACTIVATE,TRUE,
  86.                                  WA_TITLE,'select.gadget custom gadget test in E',
  87.                                  WA_IDCMP,IDCMP_CLOSEWINDOW OR
  88.                                           IDCMP_GADGETUP OR
  89.                                           IDCMP_REFRESHWINDOW,
  90.                                  NIL,NIL]))
  91.       IF (dri := GetScreenDrawInfo(win.wscreen))
  92.  
  93.          IF (vi := GetVisualInfoA(win.wscreen,NIL))
  94.  
  95.             glist := CreateContext({glist}) -> Importat! Take care of the {}!!!
  96.  
  97.             ng.leftedge := 40;
  98.             ng.topedge  := win.bordertop + 40
  99.             ng.width    := (win.wscreen.rastport.font.xsize * 18) + 30
  100.             ng.height   := win.wscreen.font.ysize + 6
  101.             ng.gadgettext := 'G_adTools 1'
  102.             ng.textattr := win.wscreen.font
  103.             ng.gadgetid := 1
  104.             ng.flags    := NIL
  105.             ng.visualinfo := vi
  106.  
  107. -> The original Source makes use of the Arg-Version and not of the Tag-Version from
  108. -> CreateGadget!!
  109.  
  110.             gad1 := CreateGadgetA(GENERIC_KIND,glist,ng,[GT_UNDERSCORE,'_',NIL,NIL])
  111.  
  112.             ng.leftedge := win.width - 40 - ng.width
  113.             ng.topedge  := ng.topedge + 40
  114.             ng.gadgettext := 'Ga_dTools 2'
  115.             ng.gadgetid := 2
  116.  
  117.             gad2 := CreateGadgetA(GENERIC_KIND,gad1,ng,[GT_UNDERSCORE,'_',NIL,NIL])
  118.  
  119.             IF (gad2)
  120.                one := InitSelectGadgetA(gad1,NIL,[GA_DRAWINFO,  dri,
  121.                                               SGA_TEXTPLACE,    PLACETEXT_RIGHT,
  122.                                               SGA_LABELS,       labels1,
  123.                                               SGA_DROPSHADOW,   TRUE,
  124.                                               SGA_FOLLOWMODE,   SGFM_KEEP,
  125.                                               NIL,NIL])
  126.  
  127.                two := InitSelectGadgetA(gad2,NIL,[GA_DRAWINFO,  dri,
  128.                                               SGA_TEXTPLACE,    PLACETEXT_LEFT,
  129.                                               SGA_LABELS,       labels2,
  130.                                               SGA_ACTIVE,       3,
  131.                                               SGA_ITEMSPACING,  2,
  132.                                               SGA_POPUPPOS,     SGPOS_BELOW,
  133.                                               SGA_SYMBOLWIDTH,  -21,
  134.                                               NIL,NIL])
  135.                AddGList(win,glist,-1,-1,NIL)
  136.                RefreshGList(glist,win,NIL,-1)
  137.                Gt_RefreshWindow(win,NIL)
  138.             ENDIF
  139.  
  140.             WHILE (fine=0)
  141.                Wait(Shl(1,win.userport.sigbit))
  142.  
  143.                WHILE (imsg := Gt_GetIMsg(win.userport))
  144.                 class := imsg.class
  145.                 code  := imsg.code
  146.                 iaddress := imsg.iaddress
  147.                  Gt_ReplyIMsg(imsg)
  148.  
  149. -> The original Source uses a lot of IF`s, i use SELECT for a cleaner Source!
  150.  
  151.                   SELECT        class
  152.                     CASE        IDCMP_CLOSEWINDOW
  153.                         fine := TRUE
  154.                     CASE        IDCMP_GADGETUP
  155.                         WriteF('Gadget: \d, Item: \d\n',iaddress.gadgetid,code)
  156.                     CASE        IDCMP_REFRESHWINDOW
  157.                      Gt_BeginRefresh(win)
  158.                      Gt_EndRefresh(win,TRUE)
  159.                   ENDSELECT
  160.                ENDWHILE
  161.             ENDWHILE
  162.  
  163.             IF (gad2) THEN RemoveGList(win,glist,-1)
  164.  
  165.             IF (one) THEN ClearSelectGadget(gad1)
  166.             IF (two) THEN ClearSelectGadget(gad2)
  167.  
  168.             FreeGadgets(glist)
  169.  
  170.             FreeVisualInfo(vi);
  171.          ENDIF
  172.  
  173.          FreeScreenDrawInfo(win.wscreen,dri)
  174.       ENDIF
  175.  
  176.       CloseWindow(win)
  177.    ELSE
  178.     Raise(ERR_WIN)
  179.    ENDIF
  180.  
  181. -> E-Note! I use Exception-Handling for Error-Parsing, instead of pure
  182. -> IF`s and RETURN-Values!
  183.  
  184. EXCEPT DO
  185.  IF (selectgadgetbase<>NIL) THEN CloseLibrary(selectgadgetbase)
  186.  
  187. -> Now close the gadtools.library again, the original Source doesn`t do this!
  188.  
  189.  IF (gadtoolsbase<>NIL)     THEN CloseLibrary(gadtoolsbase)
  190.  CleanUp(exception)     -> Leave with exception as Returncode
  191. ENDPROC
  192.